home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / pc_board / reward12.zip / REWARD.PAS < prev    next >
Pascal/Delphi Source File  |  1992-03-13  |  14KB  |  532 lines

  1.  
  2. (*
  3.  * Reward      - Generate a report of the top uploaders
  4.  *               and Reward them with a special security level
  5.  *               for PCBoard 14.x
  6.  *
  7.  * (C) 1989-1992 Samuel H. Smith, 17-sep-89 (rev. 29-Feb-92)
  8.  *
  9.  * This program is provided courtesy of:
  10.  *         The Tool Shop
  11.  *         Panorama City CA
  12.  *         (818) 891-4228
  13.  *
  14.  *
  15.  * Disclaimer
  16.  * ----------
  17.  *
  18.  * I cannot be responsible for any damages resulting from the use or mis-
  19.  * use of this program!
  20.  *
  21.  * If you have any questions, bugs, or suggestions, please contact me at
  22.  * The Tool Shop,  (818) 891-4228.
  23.  *
  24.  * Enjoy!     Samuel H. Smith
  25.  *
  26.  *)
  27.  
  28. {$DEFINE PCB14}
  29.  
  30. {$r-,s-}             (* enable range checking *)
  31. {$v-}                (* allow variable length string params *)
  32. {$M 50000,0,0}       {Stack, minheap, maxheap}
  33.  
  34.  
  35. uses OpenShare,BufIO,Tools;
  36.  
  37. const
  38.    version = 'v1.2';
  39.    revdate = '03-13-92';
  40.    pcb_version = '14.x';
  41.    max_reward = 500;    {maximum number of users to reward}
  42.    max_level = 100;     {maximum number of security level pairs in config}
  43.  
  44. type
  45.    {yymmdd dates}
  46.    yymmdd = char6;
  47.  
  48.    {level pair record}
  49.    level_pair = record
  50.       normal:  integer;
  51.       bonus:   integer;
  52.    end;
  53.  
  54.    {uploader information record}
  55.    user_rec = record
  56.       usernum:     word;
  57.       name:        string[25];
  58.       city:        string[25];
  59.       date:        yymmdd;
  60.       uploads:     word;
  61.       level:       byte;
  62.    end;
  63.  
  64.    {layout of the USERS file in PCBoard 14.x}
  65.    pcb_user_rec = record
  66.     {1  }name:          char25;
  67.     {26 }city:          char24;
  68.     {50 }passwd:        char12;         {no spaces allowed}
  69.     {62 }busphone:      char13;
  70.     {75 }phone:         char13;
  71.     {88 }date:          yymmdd;         {yymmdd of last call}
  72.     {94 }time:          char5;          {hh:mm  of last call}
  73.     {99 }expert:        char;           {pcboard expert status Y or N}
  74.     {100}protocol:      char;           {X, C, Y, N}
  75.     {101}space1:        char;           {space - reserved}
  76.     {102}filedate:      yymmdd;         {yymmdd of last file directory}
  77.     {108}level:         byte;           {security level}
  78.     {109}total_calls:   integer;        {number of times on system}
  79.     {111}pagelen:       byte;           {page length}
  80.     {112}uploads:       integer;        {number of uploads}
  81.     {114}downloads:     integer;        {number of downloads}
  82.     {116}downbytes:     double;         {daily download bytes so far}
  83.     {124}usercomment:   char30;         {user entered comment field}
  84.     {154}sysopcomment:  char30;         {sysop maintained comment field}
  85.     {184}lastused:      integer;        {minutes used so far today}
  86.     {186}expdate:       yymmdd;         {yymmdd expiration date}
  87.     {192}explevel:      byte;           {expired security level}
  88.     {193}curconf:       byte;           {current conference number}
  89.     {194}conferences:   bitmap;         {area registration 1-39 (5 bytes)}
  90.     {199}expconf:       bitmap;         {expired conference registration}
  91.     {204}scanconf:      bitmap;         {user configured scan conferences}
  92.     {209}downtotal:     double;         {total bytes downloaded, all calls}
  93.     {217}uptotal:       double;         {total bytes uploaded, all calls}
  94.     {225}dead:          char;           {positive delete flag, Y or N}
  95.  
  96.     {226}lastread:      array[0..39] of single;
  97.                                         {last message pointer, main+39 conf's}
  98.  
  99.     {386}reserved:      char5;          {reserved for future use}
  100.  
  101. (*
  102.  * THE FOLLOWING USERS FILE BYTES ARE TAKEN OVER BY PRODOOR
  103.  * FOR STORAGE OF PRODOOR-SPECIFIC DATA FOR A USER.  OTHER DOOR
  104.  * PROGRAMS SHOULD TAKE CARE TO NOT CONFLICT WITH THESE BYTE
  105.  * POSITIONS!
  106.  *)
  107.     {391}extrarec:      word;           {record number for extra user record}
  108.  
  109.     {393}flags:         byte;           {prodoor user flag bits}
  110.  
  111.     {394}mailconf:      byte;           {conference user has mail in}
  112.     {395}scratchnum:    byte;           {scratch file number - incremented for
  113.                                          each use of a scratch file}
  114.     {396}dooruse:       byte;           {times in prodoor, up to 255}
  115.     {397}earned_k:      word;           {prodoor; earned kbytes}
  116.  
  117.  
  118.     {399}reserve3:      word;           {used by qmail??}
  119.     {total size: 400}
  120.    end;
  121.  
  122.  
  123. (* ----------------------------------------------------------- *)
  124.  
  125. {config file variables}
  126. var
  127.    headerfn:   filenames;
  128.    trailerfn:  filenames;
  129.    bltfn:      filenames;
  130.    logfn:      filenames;
  131.    userfn:     filenames;
  132.    num_reward: integer;
  133.    level:      array[1..max_level] of level_pair;
  134.    levels:     integer;
  135.  
  136. {report files}
  137. var
  138.    logfd:      text;
  139.    bltfd:      text;
  140.  
  141. {working storage}
  142. var
  143.    reward:     array[1..max_reward] of user_rec;
  144.    rewards:    integer;
  145.  
  146.    usr:        pcb_user_rec;
  147.    usrlevel:   integer;
  148.  
  149.  
  150. (* ----------------------------------------------------------- *)
  151. procedure load_config;
  152. var
  153.    fd:   text;
  154.    i:    integer;
  155. begin
  156.    if paramcount <> 1 then
  157.    begin
  158.       writeln('Usage:   reward CONFIG_FILE');
  159.       writeln('Example: reward reward.cnf');
  160.       halt;
  161.    end;
  162.  
  163.    assignText(fd,paramstr(1));
  164.    {$i-} reset(fd); {$i+}
  165.    if ioresult <> 0 then
  166.    begin
  167.       writeln('Can''t open config file: ',paramstr(1));
  168.       halt;
  169.    end;
  170.  
  171.    readln(fd,headerfn);
  172.    readln(fd,trailerfn);
  173.    readln(fd,bltfn);
  174.    readln(fd,logfn);
  175.    readln(fd,userfn);
  176.    readln(fd,num_reward);
  177.  
  178.    readln(fd,levels);
  179.    for i := 1 to levels do
  180.       readln(fd,level[i].normal,level[i].bonus);
  181.  
  182.    close(fd);
  183. end;
  184.  
  185. (* ----------------------------------------------------------- *)
  186. function yymmdd_date: string6;
  187. begin
  188.    yymmdd_date := system_yy+system_mm+system_dd;
  189. end;
  190.  
  191.  
  192. (* ----------------------------------------------------------- *)
  193. function expired: boolean;
  194. begin
  195.    expired := (usr.expdate <> '000000') and (usr.expdate < yymmdd_date);
  196. end;
  197.  
  198.  
  199. (* ----------------------------------------------------------- *)
  200. procedure getlevel;
  201. begin
  202.    if expired then
  203.       usrlevel := usr.explevel
  204.    else
  205.       usrlevel := usr.level;
  206. end;
  207.  
  208.  
  209. (* ----------------------------------------------------------- *)
  210. procedure setlevel(level: integer);
  211. begin
  212.    if expired then
  213.       usr.explevel := level
  214.    else
  215.       usr.level := level;
  216.    usrlevel := level;
  217. end;
  218.  
  219.  
  220. (* ----------------------------------------------------------- *)
  221. function expand_date(date: yymmdd): string8;
  222.    {convert yymmdd to mm-dd-yy}
  223. const
  224.    tmp:  string8 = '  -  -  ';
  225. begin
  226.    tmp[1] := date[3];
  227.    tmp[2] := date[4];
  228.    tmp[4] := date[5];
  229.    tmp[5] := date[6];
  230.    tmp[7] := date[1];
  231.    tmp[8] := date[2];
  232.    expand_date := tmp;
  233. end;
  234.  
  235.  
  236. (* ----------------------------------------------------------- *)
  237. function level_included(lev: integer; var entry: integer): boolean;
  238. var
  239.    i:       integer;
  240.  
  241. begin
  242.    for i := 1 to levels do
  243.       if (level[i].normal = lev) or (level[i].bonus = lev) then
  244.       begin
  245.          level_included := true;
  246.          entry := i;
  247.          exit;
  248.       end;
  249.  
  250.    level_included := false;
  251. end;
  252.  
  253.  
  254. (* ----------------------------------------------------------- *)
  255. procedure determine_rewards;
  256. var
  257.    fd:      buffered_file;
  258.    entry:   integer;
  259.    cnt:     word;
  260.  
  261.    procedure insert_user;
  262.    var
  263.       rec:  user_rec;
  264.       i:    integer;
  265.       j:    integer;
  266.  
  267.    begin
  268.       if usr.uploads = 0 then
  269.          exit;
  270.  
  271.       rec.usernum := btell(fd);
  272.       rec.name := usr.name;
  273.       rec.city := usr.city;
  274.       rec.uploads := usr.uploads;
  275.       rec.date := usr.date;
  276.       rec.level := usrlevel;
  277.  
  278.       i := rewards;
  279.       while (i > 0) and (usr.uploads > reward[i].uploads) do
  280.          dec(i);
  281.  
  282.       if rewards = num_reward then
  283.       begin
  284.          if i = rewards then
  285.             exit;
  286.          for j := rewards-1 downto i+1 do
  287.             reward[j+1] := reward[j];
  288.       end
  289.       else
  290.       begin
  291.          for j := rewards downto i+1 do
  292.             reward[j+1] := reward[j];
  293.          inc(rewards);
  294.       end;
  295.  
  296.       reward[i+1] := rec;
  297.    end;
  298.  
  299. begin
  300.    bopen(fd,userfn,50,sizeof(usr));
  301.    if berr then
  302.    begin
  303.       writeln('Can''t open user file ',userfn);
  304.       halt;
  305.    end;
  306.  
  307.    writeln('Scanning ',userfn);
  308.    cnt :=0;
  309.    rewards := 0;
  310.  
  311.    while not berr do
  312.    begin
  313.       inc(cnt);
  314.       if (cnt mod 64) = 0 then
  315.          write(cnt:7,' users'^M);
  316.  
  317.       bread(fd,usr);
  318.       getlevel;
  319.  
  320.       if level_included(usrlevel,entry) then
  321.          insert_user;
  322.    end;
  323.  
  324.    bclose(fd);
  325.  
  326.    writeln(cnt:7,' users scanned.');
  327.    writeln;
  328.  
  329.    writeln(logfd,'   ',cnt,' user records scanned, ',rewards,' will be rewarded for uploads.');
  330. end;
  331.  
  332.  
  333. (* ----------------------------------------------------------- *)
  334. procedure give_rewards;
  335. var
  336.    fd:      buffered_file;
  337.    rec:     word;
  338.    upd:     word;
  339.    entry:   integer;
  340.    changed: boolean;
  341.  
  342.    procedure report_change( var fd: text; why: string);
  343.    begin
  344.       write(fd,'   ',usr.name,' ',usr.uploads:4,' U/L   ',why,' ',usrlevel);
  345.       if expired then
  346.          write(fd,' (exp ',usr.level,' ',expand_date(usr.expdate),')');
  347.       writeln(fd);
  348.    end;
  349.  
  350.    procedure update_user;
  351.    var
  352.       i: integer;
  353.    begin
  354.       changed := false;
  355.  
  356.       for i := 1 to rewards do
  357.          if reward[i].usernum = rec then
  358.          begin
  359.             if usrlevel = level[entry].normal then
  360.             begin
  361.                setlevel(level[entry].bonus);
  362.  
  363.                report_change(logfd,'upgraded to');
  364.                report_change(output,'upgraded to');
  365.                changed := true;
  366.             end
  367.             else
  368.  
  369.             begin
  370.                {report_change(logfd,' remains at');}
  371.                report_change(output,'remains at');
  372.             end;
  373.  
  374.             exit;
  375.          end;
  376.  
  377.  
  378.       {not in reward list, downgrade if needed}
  379.       if usrlevel = level[entry].bonus then
  380.       begin
  381.          setlevel(level[entry].normal);
  382.          report_change(logfd,'returned to');
  383.          report_change(output,'returned to');
  384.          changed := true;
  385.       end;
  386.    end;
  387.  
  388. begin
  389.    bopen(fd,userfn,50,sizeof(usr));
  390.    if berr then
  391.    begin
  392.       writeln('Can''t reopen user file ',userfn);
  393.       halt;
  394.    end;
  395.  
  396.    writeln('Updating ',userfn);
  397.    upd := 0;
  398.  
  399.    while not berr do
  400.    begin
  401.       bread(fd,usr);
  402.       getlevel;
  403.  
  404.       rec := btell(fd);
  405.  
  406.       if level_included(usrlevel,entry) then
  407.       begin
  408.          update_user;
  409.  
  410.          if changed then
  411.          begin
  412.             bseek(fd,rec-1);
  413.             bwrite(fd,usr);
  414.             inc(upd);
  415.          end;
  416.       end;
  417.  
  418.       if (rec mod 64) = 0 then
  419.          write(rec:7,' users, ',upd,' updated.'^M);
  420.    end;
  421.  
  422.    bclose(fd);
  423.    writeln(rec:7,' users, ',upd,' updated.'^M);
  424.    writeln(logfd,'   ',upd,' user records updated.');
  425.    writeln;
  426. end;
  427.  
  428.  
  429. (* ----------------------------------------------------------- *)
  430. procedure append_text(var fd: text; fn: filenames);
  431. var
  432.    ifd:  text;
  433.    line: string;
  434. begin
  435.    assignText(ifd,fn);
  436.    {$i-} reset(ifd); {$i+}
  437.    if ioresult <> 0 then
  438.    begin
  439.       writeln('Can''t access text file: ',fn);
  440.       exit;
  441.    end;
  442.  
  443.    while not eof(ifd) do
  444.    begin
  445.       readln(ifd,line);
  446.       writeln(fd,line);
  447.    end;
  448.  
  449.    close(ifd);
  450. end;
  451.  
  452.  
  453. (* ----------------------------------------------------------- *)
  454. procedure generate_blt;
  455. var
  456.    i: integer;
  457. begin
  458.    writeln('Generating ',bltfn);
  459.    assignText(bltfd,bltfn);
  460.    rewrite(bltfd);
  461.    append_text(bltfd,headerfn);
  462.  
  463.    writeln(bltfd);
  464.    writeln(bltfd,'  User Name               Calling From             Last On   # of UL''s  Level');
  465.    writeln(bltfd,'  _________               ____________             ________  _________  _____');
  466.    writeln(bltfd);
  467.  
  468.    for i := 1 to rewards do
  469.    with reward[i] do
  470.       writeln(bltfd,'  ',
  471.                   copy(name,1,23):23,' ',
  472.                   copy(city,1,23):23,'  ',
  473.                   expand_date(date):8,' ',
  474.                   uploads:8,
  475.                   level:8);
  476.  
  477.    append_text(bltfd,trailerfn);
  478.    close(bltfd);
  479. end;
  480.  
  481.  
  482. (* ----------------------------------------------------------- *)
  483. procedure open_reports;
  484. begin
  485.    assignText(logfd,logfn);
  486.    append(logfd);
  487.    writeln(logfd,system_date,' ',system_time,' Reward ',version,' Execution Log');
  488. end;
  489.  
  490.  
  491. (* ----------------------------------------------------------- *)
  492. procedure close_reports;
  493. begin
  494.    writeln(logfd,system_date,' ',system_time,' Reward Run Ended');
  495.    writeln(logfd,'---------------------------------------------------');
  496.    close(logfd);
  497.    writeln('Reward Run Ended.');
  498. end;
  499.  
  500.  
  501.  
  502. (* ----------------------------------------------------------- *)
  503. (*
  504.  * main program
  505.  *
  506.  *)
  507.  
  508. begin
  509.    writeln;
  510.    writeln('Reward ',version,' of ',revdate,' for PCBoard ',pcb_version);
  511.    writeln('Copyright 1992 Samuel H. Smith;  Courtesy of The Tool Shop, (818) 891-6780');
  512.    writeln;
  513.  
  514.    load_config;         {load config file, build list of levels
  515.                          reward/normal to work with}
  516.  
  517.    open_reports;
  518.  
  519.    determine_rewards;   {pass through user file and build list of users
  520.                          in configured security levels, keeping only the
  521.                          top uploaders in the list}
  522.  
  523.    give_rewards;        {pass through user file again, addigning top
  524.                          uploaders to reward level and returning others
  525.                          to the normal level}
  526.  
  527.    generate_blt;
  528.  
  529.    close_reports;
  530. end.
  531.  
  532.